home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d15 / maximo_1.arc / TXT.ARC / MASTER.TXT < prev    next >
Encoding:
Text File  |  1991-08-20  |  6.0 KB  |  324 lines
  1. ;
  2. ;  MASTER -- MAIN PSDI PROGRAM
  3. ;        (c) Copyright 1990 Chris Butler
  4. ;
  5.  
  6. video m
  7. set esc "CTRL-Q"
  8. set space off
  9.  
  10. set i 1
  11. goto mstr_init
  12.  
  13. ;reenter:    ; don't blank scr w/VIDEO on reentry
  14. entry_1:
  15.  set i 1
  16.  goto mstr_init
  17. entry_2:
  18.  set i 2
  19.  goto mstr_init
  20. entry_3:
  21.  set i 3
  22.  goto mstr_init
  23. entry_4:
  24.  set i 4
  25.  goto mstr_init
  26. entry_5:
  27.  set i 5
  28.  goto mstr_init
  29. entry_6:
  30.  set i 6
  31.  goto mstr_init
  32. entry_7:
  33.  set i 7
  34.  goto mstr_init
  35. entry_8:
  36.  set i 8
  37.  goto mstr_init
  38. entry_9:
  39.  set i 9
  40.  goto mstr_init
  41. entry_10:
  42.  set i 10
  43.  goto mstr_init
  44. entry_11:
  45.  set i 11
  46.  goto mstr_init
  47. entry_12:
  48.  set i 12
  49.  goto mstr_init
  50. entry_13:
  51.  set i 13
  52.  goto mstr_init
  53. entry_14:
  54.  set i 14
  55.  goto mstr_init
  56. entry_15:
  57.  set i 15
  58.  goto mstr_init
  59.  
  60.  
  61. ;CLOSEGL
  62. mstr_init:
  63. global keycolor 8
  64. global numbboxes 17
  65. init_box_list    ; initialize menu data
  66. setrgb 0 0,0,0 1
  67. setrgb 6 21,42,42 1
  68. setrgb 7 42,42,42 1
  69. setrgb 8 52,52,52 1
  70. setrgb 9 0,0,63 1
  71. setrgb 15 63,63,63 1
  72.  
  73. pload menu9.pic 1
  74. pfade 9 1 300
  75. pfree 1
  76. palette 1
  77.  
  78. toploop:
  79.   set y2  @("box."$@i$".y2") 
  80.   color 0
  81.   box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
  82.   color 8
  83.   box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
  84.   waitkey 20 nogot
  85.   goto gotchar
  86. nogot:
  87.   color 9
  88.   box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
  89.   box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
  90.   waitkey 20 toploop
  91.   goto gotchar
  92.  
  93. gotchar:
  94.     color 0    ; black box outline
  95.     box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
  96.     color 8
  97.     box @("box."$@i$".x1")-3 @("box."$@i$".y1")-4 @("box."$@i$".x2")+4 @y2+3
  98.     ifkey ENTER do_proc UP do_up DOWN do_down 
  99.     noise 600 300 50
  100.     goto toploop
  101.   do_down:
  102.     if @i==@numbboxes
  103.        set i 1
  104.      else
  105.        set i @i+1
  106.      endif
  107.     goto toploop
  108.   do_up:
  109.     if @i==1
  110.        set i @numbboxes
  111.     else
  112.        set i @i-1 
  113.     endif
  114.     goto toploop
  115.   do_proc:
  116.     global h 5+@("box."$@i$".y2")-@("box."$@i$".y1") 
  117.     global w 5+@("box."$@i$".x2")-@("box."$@i$".x1")
  118.     pushbutton @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @h @w @keycolor
  119.     goto @("jmptbl."$@i)
  120.  
  121. NOISE 1000 500 100    ; shouldn't get here
  122. EXIT
  123.  
  124. ;
  125. ;  MAKEMENU -- setup menu screen
  126. ;
  127. makemenu:
  128. color 8
  129. clearscr
  130. set i 1
  131. mark @numbboxes
  132.   set y2  @("box."$@i$".y2") 
  133.   color @keycolor
  134.   rect @("box."$@i$".x1") @("box."$@i$".y1") @("box."$@i$".x2") @y2
  135.   color 0
  136.   box @("box."$@i$".x1")-2 @("box."$@i$".y1")-3 @("box."$@i$".x2")+3 @y2+2
  137.   set i @i+1
  138. loop
  139. return; subr MAKEMENU
  140.  
  141. ;
  142. ;  INITBOXLIST -- setup menu button data list
  143. ;
  144. init_box_list:
  145. databegin menudata
  146. local i 1
  147. mark @numbboxes
  148.   global "box."$@i$".x1" @
  149.   global "box."$@i$".y1" @
  150.   global "box."$@i$".x2" @
  151.   global "box."$@i$".y2" @
  152.   global "jmptbl."$@i    @
  153.  
  154.   set i @i+1
  155. loop
  156. return ; (init_box_list)
  157.  
  158. menudata:
  159.  
  160. 304 431 624 447  shebang
  161. 304 406 624 422  ovrvu
  162. 304 381 624 397  ibmbp
  163. 304 356 624 372  supp
  164. 304 331 624 347  ww
  165. 304 306 624 322  clients
  166. 304 281 624 297  engr
  167. 304 256 624 272  sched
  168. 304 231 624 247  inv
  169. 304 206 624 222  accntg
  170. 304 181 624 197  mis
  171. 304 156 624 172  mgr
  172. 304 131 624 147  tstdrv
  173. 304 106 624 122  roi
  174. 304  81 624  97  about
  175. 304  56 624  72  help
  176. 304  31 624  47  dos
  177.  
  178. dataend
  179.  
  180. shebang:
  181.   link overview.txt all
  182. ovrvu:
  183.   link overview.txt  
  184. ibmbp:
  185.   link ibmbp.txt
  186. supp:
  187.   link support.txt 
  188. ww:
  189.   link ww.txt
  190. clients:
  191.   link clients.txt
  192. engr:
  193.   link engr.txt
  194. sched:
  195.   link sched.txt
  196. inv:
  197.   link inv.txt 
  198. accntg:
  199.   link purch.txt
  200. mis:
  201.   link mis.txt
  202. mgr:
  203.   link mgr.txt
  204. tstdrv:
  205.   link udrive.txt
  206. roi:
  207.   link roi.txt
  208. about:
  209.   gosub about_subr
  210.   goto  toploop
  211. help:
  212.   gosub help_subr
  213.   goto  toploop
  214. dos:
  215.   exit
  216.  
  217. ;  HELP_SUBR -- main menu help
  218. help_subr:
  219. cgetbuf 1 24,27 272,471 1 0
  220. cload helpclip.clp 2 1 0
  221. cfade 20 24,27 2 100
  222. waitkey
  223. cfade 20 24,27 1
  224. cfree 1 2
  225. return    ; HELP_SUBR
  226.  
  227. ;  ABOUT_SUBR -- intrctv mkg bit
  228. about_subr:
  229. cgetbuf 1 24,26 272,224 1 0
  230. cload about.clp 2 1 0
  231. cfade 20 24,26 2 100
  232. waitkey
  233. cfade 20 24,26 1
  234. cfree 1 2
  235. return    ; ABOUT_SUBR
  236.  
  237. ;
  238. ;  COLORBARS -- diagnostic routine
  239. ;
  240. colorbars:
  241. set i "0"
  242. offset 50,350
  243. mark 16
  244.   color @i
  245.   rect    0,0 20,20
  246.   color 0  
  247.   text    5,5 @i
  248.   offset 20,0 r
  249.   set i @i+1
  250. loop
  251. offset 0,0    ; COLORBARS code
  252. return      ; subr COLORBARS
  253.  
  254. ;
  255. ;  PUSHBUTTON -- actuate onscreen "button"
  256. ;            uses MS Windows button format (white #15 top line and
  257. ;            2 bars of gray #8 shading)
  258. ;
  259. pushbutton:
  260. local llx @1    ; lower left corner of button x
  261. local lly @2    ; lower left corner          y
  262. local h @3    ; height
  263. local w @4    ; width
  264. local keycolor @5 ; color of keytop 
  265.         ; note: uses buffer 1 
  266.  
  267. local bndryoff (@llx+2)%8 ; boundary offset (@llx+2=x start of clipping)
  268. set wait "0"  ; diagnostic switch
  269.  
  270. cgetbuf 1 @llx+2,@lly+3 @llx+@w-3,@lly+@h-2 0 0; grab center of button [shifted]
  271. color @keycolor  
  272. if @wait
  273.   waitkey 
  274. endif
  275. line @llx+1,@lly+1 @llx+1,@lly+@h-1 ; gray out left white line
  276. line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1 ; gray out top white line
  277.  
  278. putup 1+@bndryoff,-1 1
  279. color @keycolor
  280. point @llx+2,@lly+2 
  281. point @llx+@w-2,@lly+@h-2
  282. if @wait
  283.   waitkey 
  284. endif
  285.  
  286. putup 2+@bndryoff,-2 1
  287. point @llx+2,@lly+1 
  288. point @llx+3,@lly+1
  289. point @llx+@w-1,@lly+@h-2
  290. point @llx+@w-1,@lly+@h-3
  291. color 8
  292. line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
  293. color 0
  294. line @llx+1,@lly+1 @llx+1,@lly+@h-1
  295. if @wait
  296.   waitkey 
  297. endif
  298.  
  299. putup 1+@bndryoff,-1 1
  300. color 7
  301. line @llx+2,@lly+1 @llx+@w-1,@lly+1
  302. line @llx+@w-1,@lly+1 @llx+@w-1,@lly+@h-2
  303. color @keycolor
  304. line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
  305. line @llx+1,@lly+1 @llx+1,@lly+@h-1
  306. if @wait
  307.   waitkey 
  308. endif
  309.  
  310.  
  311. cgetbuf 1 @llx+3,@lly+1 @llx+@w-1,@lly+@h-3 0 0 ;
  312. putup @bndryoff,1 1  ; new clipping from lr corner
  313. color 15
  314. line @llx+1,@lly+1 @llx+1,@lly+@h-1
  315. line @llx+1,@lly+@h-1 @llx+@w-1,@lly+@h-1
  316. color 7
  317. point @llx+1,@lly+1        ; ll corner
  318. point @llx+@w-1,@lly+@h-1    ; tr corner
  319. if @wait
  320.   waitkey 
  321. endif
  322.  
  323. return ; subr PUSHBUTTON
  324.